home *** CD-ROM | disk | FTP | other *** search
/ Tiger Disk 30 / Tiger_Disk_030_1996-09_Tiger-Crew-Disk_de_Side_C.d64 / hi-q (.txt) next >
Commodore BASIC  |  2023-02-26  |  10KB  |  368 lines
  1. 1 goto910
  2. 2 print"X[169][141][169][141]x{$60} [234][255][169][255][133][145]l4[234]X[169]1[141][169][234][141]x{$60} 
  3. 3 [153]"Xstepginputstopstepinputonx{$60} (NULL)(NULL)step(NULL)inputlistlx(NULL)Xstepuinputstopstep(NULL)inputonx{$60}    
  4. 4 print"XHHH[170]H[168]HHHHHHH[152]h[138]hx{$60}    
  5. 5 [153]"HHHHHHH{$60}  
  6. 6 print"[160][255][200][132][251][169][216][133][252] [241][183][138][162][160][255][200][145][251][136][208][251][230][252][202][208][246]{$60}   
  7. 7 [153]"newclose(NULL)left$>(NULL)on(NULL)let(NULL)(NULL)(NULL)(NULL)(NULL)(NULL)mid$(NULL)(NULL){$60}  
  8. 35 ifuw=0thensysuu,15
  9. 40 pokeuc,0:pokeun,0:ur$="":ui$="":iful=0thenul=39
  10. 45 getui$:ifui$=""then45
  11. 50 ua=asc(ui$):ur=len(ur$):ifua=13andur>0thenpokeuc,1:print" [157]";:goto70
  12. 55 ifua=20thenon-(ur=0)goto45:ur$=left$(ur$,ur-1):print"[157]  [157][157]";:goto45
  13. 60 ifur=ulthen45
  14. 65 gosub95:ur$=ur$+ui$:printui$;:goto45
  15. 70 ifur$=ux$thenprint"[157] ";:goto145
  16. 75 forui=urto1step-1:ifmid$(ur$,ui,1)=" "thennext
  17. 80 ur$=left$(ur$,ui):print:return
  18. 95 iflen(us$)=0then110
  19. 100 forui=1tolen(us$):ifui$<>mid$(us$,ui,1)thennext:ui$=""
  20. 105 return
  21. 110 ifua=46thenreturn
  22. 115 ifua=32andur<>0thenreturn
  23. 120 ifua>47andua<58thenreturn
  24. 125 ifua>64andua<91thenreturn
  25. 130 ifua<193orua>218thenui$="":return
  26. 135 ifpeek(ut)=uu%thenui$=chr$(ua-128)
  27. 140 return
  28. 145 gosub170:poke251,0:poke252,us/256:poke253,0:poke254,uf:sysuv
  29. 150 uz=1:uv%=peek(ut):goto300
  30. 155 uz=0:us$=uj$:ug$=uk$:ut$=ul$:up=uj:ul=uk:print"[147]";:ifuw=0thenpokeuy,6:pokeux,14
  31. 160 pokeut,uv%:poke251,0:poke252,uf:poke253,0:poke254,us/256:sysuv:ifuw=0thensysuu,15
  32. 165 pokeu1,u1%:pokeu2,u2%:pokeu3,u3%-1:pokeu4,u4%:goto35
  33. 170 u1%=peek(u1):u2%=peek(u2):u3%=peek(u3):u4%=peek(u4)
  34. 175 uj$=us$:uk$=ug$:ul$=ut$:uj=up:uk=ul:return
  35. 300 print"[147]":pokeut,uu%:ifuw=0thenpokeuy,12:pokeux,6
  36. 305 print"                m e n u"
  37. 310 print"    --------------------------------"
  38. 315 print"       1.   begin hi-q"
  39. 320 print"       2.   student instructions"
  40. 325 print"       3.   teacher instructions"
  41. 330 print"       4.   quit"
  42. 335 print"    --------------------------------"
  43. 340 print"       press a number key (1-4) ";
  44. 345 ul=1:us$="1234"
  45. 347 gosub35:us$=""
  46. 350 onval(ur$)gosub1000,400,500,390
  47. 355 goto300
  48. 370 ifuz=1thensysup%:goto155
  49. 375 return
  50. 390 sysue:print"[154][147]":ifuw=0thenpokeuy,6:pokeux,14:sysuu,14
  51. 395 clr:end
  52. 400 print"[147]":pokeut,ul%:ifuw=0thenpokeuy,11:pokeux,12
  53. 405 ut$=" [200]i-[209]":uh=1:up=0:ug$="[211]tudent [201]nst"
  54. 407 gosub3050
  55. 410 ut$=" hi-q":uh=1:ug$="student inst":print"[147]":pokeut,uu%:gosub850
  56. 411 print "             [209]   [209]   [209]"
  57. 412 print "             13  14  15":printtab(25)"this is    "
  58. 413 print "             [209]   [209]   [209]   the playing"
  59. 414 print "             23  24  25  board      ":print
  60. 415 print "     [209][160][160][160][209][160][160][160][209][160][160][160][209][160][160][160][209][160][160][160][209][160][160][160][209]"
  61. 416 print "     31  32  33  34  35  36  37":print
  62. 417 print "     [209][160][160][160][209][160][160][160][209][160][160][160][209][160][160][160][209][160][160][160][209] [160][160][209]"
  63. 418 print "     41  42  43  44  45  46  47":print
  64. 419 print "     [209][160][160][160][209][160][160][160][209][160][160][160][209][160][160][160][209][160][160][160][209][160][160][160][209]"
  65. 420 print "     51  52  53  54  55  56  57":print
  66. 421 print "             [209][160][160][160][209][160][160][160][209]"
  67. 422 print "             63  64  65":print
  68. 423 print "             [209][160][160][160][209][160][160][160][209]"
  69. 424 print "             73  74  75":print
  70. 485 gosub835
  71. 490 ifuz=1thensysup%:goto155
  72. 495 return
  73. 500 print"[147]":pokeut,ul%:ifuw=0thenpokeuy,2:pokeux,10
  74. 501 ut$=" [200]i-[209]":uh=1:up=0:ug$="[212]eacher [201]nst":gosub850
  75. 502 print"     [212]o the best of our knowledge,"
  76. 503 print"     this program is in the public"
  77. 504 print"     domain.  [201]f this is not true,"
  78. 505 print"     please contact:"
  79. 506 print"      [195][207][205][205][207][196][207][210][197][160][194][213][211][201][206][197][211][211][160][205][193][195][200][201][206][197][211]"
  80. 507 print"          3370 [208]harmacy [193]ve.
  81. 508 [153]"          atngincourt, (NULL)ntario"
  82. 509 [153]"          lenanada, (NULL)1(NULL) 2(NULL)4"
  83. 510 [153]"          (416) 499-4292"
  84. 511 uh[178]1:[141]835:[141]850
  85. 512 [153]"      (NULL)rogram (NULL)ame:  left$i-(NULL)"
  86. 513 [153]"      (NULL)ritten by  : "
  87. 514 [153]"      (NULL)evised by  :  lenhris (NULL)aiskums"
  88. 515 [153]"      (NULL)his program will run on any
  89. 516 print"         [194][193][211][201][195][160]2.0 [208][197][212] [195]omputer
  90. 517 [153]"         peekatn(NULL)right$len 4.0 (NULL)val(NULL)closelenomputer
  91. 518 print"         8032 [195][194][205] [195]omputer
  92. 519 [153]"         lenommodore 64 lenomputer
  93. 585 gosub835
  94. 590 ifuz=1thensysup%:goto155
  95. 595 return
  96. 700 printuc$"[147]before running this program on an 8032
  97. 705 [153]"      load the 'cbm 4032' program":[128]
  98. 800 [153]"load";:[151]ut,uu%:[139]uw[178]0[167][151]uy,1:[151]ux,14
  99. 801 [129]i[178]1[164]38:[153]" wait";:[130]
  100. 802 [129]i[178]1[164]22:[153]"cmd wait";:[130]
  101. 803 [129]i[178]1[164]37:[153]"cmdcmd wait";:[130]
  102. 804 [129]i[178]1[164]22:[153]"oncmd wait";:[130]
  103. 805 [153]"step  wait
  104. 806 print" [146]   [146][169]
  105. 807 [153]" wait  tab((NULL)wait o m m o d o r e
  106. 808 print"[223]  [146]
  107. 809 [153]"educational
  108. 810 print"software
  109. 811 [153]"1983
  110. 812 printleft$(ud$,24);"press space bar or wait[146]"uc$:ui=0
  111. 813 getui$:ifui$<>" "thenui=ui+1:ifui<250then813
  112. 814 goto300
  113. 835 pokeun,0:printleft$(ud$,24);"press space bar to continue[146]"
  114. 840 getui$:ifui$<>" "then840
  115. 845 return
  116. 850 up=up+1:print"[147]"left$(ut$+up$,21);right$(up$+ug$+str$(up),18)
  117. 851 ifuw=0thensysuu,15
  118. 855 print" --------------------------------------"
  119. 860 ifuh=0thenprintleft$(ud$,24);left$(up$,7);"help - press   h <return>"
  120. 865 uh=0:print"":return
  121. 875 printleft$(ud$,24);"           one moment please...     ":return
  122. 900 ux$="h":us=32768:u1=196:u2=197:u3=198:u4=216:uc=167:ub=1024:ud=1084:ue=1105
  123. 901 ut=59468:uu%=12:ul%=14:up%=1158:un=158:poke50003,0:uw=peek(50003):uf=peek(53)
  124. 902 ifuw=0thenus=1024:u1=209:u2=210:u3=211:u4=214:uc=204:ub=2048:ux=53280:ud=2064
  125. 903 ifuw=0thenut=53272:uu%=21:ul%=23:up%=2151:un=198:uy=53281:uu=2199:ue=2087
  126. 904 uc$=chr$(155):uv=1214:ifuw=0thenuf=196:uv=2238
  127. 905 ud$="":up$="                                      "
  128. 906 dimb(70),t(9,9),b1(33),b2(33)
  129. 907 def fnpv(a)=int(us+214+(int(a/10)-1)*80+((a/10-int(a/10))*10-1)*2+.5)
  130. 909 return
  131. 910 gosub900:print"[147]":print"[160]":rem shifted space
  132. 915 ifpeek(us+40)<>96then700
  133. 920 if(fre(0)-(sgn(fre(0))<0)*65536)>500then935
  134. 925 printuc$"[147]this machine does not have enough"
  135. 930 print"memory to run this program !":end
  136. 935 print"[147]"uc$:ifuw=0then965
  137. 940 ifuf=60oruf=108oruf=124then950
  138. 945 poke52,0:poke53,uf-4:clr:gosub900
  139. 950 ifuw=160thenpoke1103,88:poke1104,228:poke1107,85:poke1111,228:goto965
  140. 955 ifuw<>1thenprint"[147]this pgm will not work on this machine!":end
  141. 960 poke1103,49:poke1104,230:poke1107,46:poke1111,230:goto965
  142. 965 sysud
  143. 970 gosub800:goto300
  144. 1000 ifuz=1thensysup%:sysup%:uz=0
  145. 1001 print"[147]"uc$;:restore:ifuw=0thenpokeuy,6:pokeux,14
  146. 1050 rem revised by tom ferguson
  147. 1055 gosub875
  148. 1060 ct=-1
  149. 1070 goto1320
  150. 1100 poke ut,peek(ut) and 253 or 12
  151. 1110 print"[147]hi-q":print:print:printtab(13)"copyright by"
  152. 1120 print:print:print tab(10);"creative computing":print tab(12);"p.o. box 789-m"
  153. 1130 print tab(5);"morristown, new jersey 07960":k=ti
  154. 1140 if ti<k+200 and k<=ti then 1140
  155. 1150 return
  156. 1320 rem *** set up board
  157. 1330 for r=1 to 9
  158. 1340 for c=1 to 9
  159. 1350 if (r-4)*(r-5)*(r-6)=0 then 1390
  160. 1360 if (c-4)*(c-5)*(c-6)=0 then 1390
  161. 1370 t(r,c)=-5
  162. 1380 goto 1410
  163. 1390 if (r-1)*(c-1)*(r-9)*(c-9)=0 then 1370
  164. 1400 t(r,c)=5
  165. 1410 next c
  166. 1420 next r
  167. 1430 t(5,5)=0:gosub 1710
  168. 1440 gosub 2640
  169. 1450 rem *** input move and chech on legality
  170. 1460 for w=1 to 33
  171. 1470 read m
  172. 1480 data 13,14,15,22,23,24,29,30,31,32,33,34,35,38,39,40,41
  173. 1490 data 42,43,44,47,48,49,50,51,52,53,58,59,60,67,68,69
  174. 1500 b(m)=-7:next w
  175. 1510 b(41)=-3
  176. 1520 printleft$(ud$,18):forgp=1to5:printup$:nextgp:printleft$(ud$,18)
  177. 1522 print " move which piece?   [157][157]";
  178. 1525 ul=2:us$="h1234567":gosub35:z=val(ur$):p1=z
  179. 1530 b4=z:gosub 2750:z=b4
  180. 1540 if b(z)=-7 then 1590
  181. 1550 printtab(25)"[145]illegal move":k=ti
  182. 1560 if ti < k+200 then 1560
  183. 1570 printtab(25)"[145]             "
  184. 1580 goto 1522
  185. 1590 print " to where?   [157][157]";
  186. 1595 ul=2:us$="h1234567":gosub35:p=val(ur$):p2=p
  187. 1600 b4=p:gosub 2750:p=b4
  188. 1610 if b(p)<>0 then 1620
  189. 1611 printtab(25)"[145]illegal move":k=ti
  190. 1612 if ti < k+200 then 1612
  191. 1613 printtab(25)"[145]             [145][145]"
  192. 1614 goto 1520
  193. 1620 if b(p)<>-7then 1630
  194. 1621 goto1611
  195. 1630 if z=p then 1520
  196. 1640 if ((z+p)/2)=int((z+p)/2) then 1660
  197. 1650 goto 1611
  198. 1660 if (abs(z-p)-2)*(abs(z-p)-18) <> 0 then 1611
  199. 1670 gosub 1960
  200. 1680 gosub4000
  201. 1690 gosub 2220
  202. 1700 goto 1520
  203. 1710 rem *** print board
  204. 1712 ifct=-1thenprint"[147]"
  205. 1715 ut$=" hi-q":ug$="":ct=ct+1:up=ct:gosub850
  206. 1720 print "";
  207. 1725 print"";
  208. 1730 for b4=1 to 7
  209. 1740 print tab(((b4)*2)+11);str$(b4);
  210. 1750 next b4
  211. 1760 print "[145]"
  212. 1770 for x=1 to 9
  213. 1780 if x-1 = 0 then 1810
  214. 1790 if x-1 > 7 then 1810
  215. 1800 print tab(11);str$(x-1);
  216. 1810 for y=1 to 9
  217. 1820 if (x-1)*(x-9)*(y-1)*(y-9)=0 then 1850
  218. 1830 if (x-4)*(x-5)*(x-6)=0 then 1870
  219. 1840 if (y-4)*(y-5)*(y-6) =0 then 1870
  220. 1850 rem
  221. 1860 goto 1910
  222. 1870 if t(x,y) <> 5 then 1900
  223. 1880 print tab((y*2)+10);"[209]";
  224. 1890 goto 1910
  225. 1900 print tab((y*2)+10);"[215]";
  226. 1910 rem
  227. 1920 next y
  228. 1930 print:print
  229. 1940 next x
  230. 1950 return
  231. 1960 rem *** update boards:
  232. 1970 c=1:for x=1 to 9
  233. 1980 for y=1 to 9
  234. 1990 if c <> z then 2180
  235. 2000 if c+2 <> p then 2050
  236. 2010 if t(x,y+1)=0 then 1611
  237. 2020 t(x,y+2)=5
  238. 2030 t(x,y+1)=0:b(c+1)= -3
  239. 2040 goto 2160
  240. 2050 if c+18 <> p then 2090
  241. 2060 if t(x+1,y)=0 then 1611
  242. 2070 t(x+2,y)=5:t(x+1,y)=0:b(c+9)=-3
  243. 2080 goto 2160
  244. 2090 if c-2 <> p then 2130
  245. 2100 if t(x,y-1)=0 then 1611
  246. 2110 t(x,y-2)=5:t(x,y-1)=0:b(c-1)=-3
  247. 2120 goto 2160
  248. 2130 if c-18 <> p then 2180
  249. 2140 if t(x-1,y)=0 then 1611
  250. 2150 t(x-2,y)=5:t(x-1,y)=0:b(c-9)=-3
  251. 2160 b(z)=-3:b(p)=-7
  252. 2170 t(x,y)=0:goto 2210
  253. 2180 c=c+1
  254. 2190 next y
  255. 2200 next x
  256. 2210 return
  257. 2220 rem *** check if game is over.
  258. 2230 f=0
  259. 2240 for r=2 to 8
  260. 2250 for c=2 to 8
  261. 2260 if t(r,c)<>5 then 2440
  262. 2270 f=f+1
  263. 2280 for a=r-1 to r+1
  264. 2290 t=0
  265. 2300 for b=c-1 to c+1
  266. 2310 t=t+t(a,b)
  267. 2320 next b
  268. 2330 if t <> 10 then 2350
  269. 2340 if t(a,c) <> 0 then 2590
  270. 2350 next a
  271. 2360 for x=c-1 to c+1
  272. 2370 t=0
  273. 2380 for y=r-1 to r+1
  274. 2390 t=t+t(y,x)
  275. 2400 next y
  276. 2410 if t <> 10 then 2430
  277. 2420 if t(r,x) <> 0 then 2590
  278. 2430 next x
  279. 2440 next c
  280. 2450 next r
  281. 2460 rem *** game is over.
  282. 2470 gosub850:print" the game is over."
  283. 2480 print" you had";f;"pieces remaining."
  284. 2490 if f <> 1 then 2520
  285. 2500 print " bravo! you made a perfect score!"
  286. 2510 rem
  287. 2520 print " play again? ";
  288. 2530 ul=1:us$="hyn":gosub35:a$=ur$
  289. 2540 if a$="n"thenreturn
  290. 2560 print"[147]";
  291. 2570 restore: goto 1320
  292. 2580 stop
  293. 2590 return
  294. 2640 rem
  295. 2650 for b3=1 to 33
  296. 2660 read b1(b3)
  297. 2670 next b3
  298. 2680 for b3=1 to 33
  299. 2690 read b2(b3)
  300. 2700 next b3
  301. 2710 restore
  302. 2720 return
  303. 2730 data 13,14,15,23,24,25,31,32,33,34,35,36,37
  304. 2740 data 41,42,43,44,45,46,47,51,52,53,54,55,56,57,63,64,65,73,74,75
  305. 2750 rem
  306. 2760 for b3=1 to 33
  307. 2770 if b2(b3)=b4 then 2810
  308. 2780 next b3
  309. 2790 b4=0
  310. 2800 return
  311. 2810 b4=b1(b3)
  312. 2820 goto 2800
  313. 2830 rem
  314. 2840 print "press the space-bar to continue."
  315. 2850 geta$:ifa$<>" "then2850
  316. 2860 print "[147]";
  317. 2870 return
  318. 2880 rem: instructions and explanation
  319. 2890 rem:    of board and how to enter
  320. 2900 rem:    responses.
  321. 2910 up=3:pokeut,ul%:gosub850:print"     [212]o enter a peg number, type its"
  322. 2920 print " row number and its column number":print" as one number."
  323. 2930 print " [198]or example:":print " the topmost,";
  324. 2940 print " leftmost  peg is 13."
  325. 2950 print " [212]he middle of the board":print" (which will be empty at first)";
  326. 2960 print " is 44."
  327. 2970 print " [212]he lowest, rightmost peg is 75."
  328. 2980 gosub835:up=4:gosub850:print"     [217]ou will first be asked
  329. 2985 [153]" the location of a peg to be moved.
  330. 2990 print" ('move which piece?')"
  331. 3000 print" then you will be asked for the":print" destination."
  332. 3010 print" ('to where?')"
  333. 3020 print:print" [215]hen the board is printed, there will"
  334. 3030 print" be guides to help you select a peg."
  335. 3035 gosub835
  336. 3040 return
  337. 3050 rem
  338. 3055 up=0:pokeut,ul%:gosub850
  339. 3060 print"     [212]his is a computerized version"
  340. 3070 print" of an old [197]uropean solitaire game of"
  341. 3080 print" logic called [200][201]-[209].  [212]he game starts"
  342. 3090 print" with a pegboard shaped like a cross"
  343. 3100 print" having pegs in all holes but the "
  344. 3110 print" center.  [212]he object of this game is"
  345. 3120 print" to remove all 32 pegs, or as many as"
  346. 3130 print" possible, by jumping into an empty"
  347. 3140 print" hole--the jumped peg is then removed."
  348. 3165 gosub835:pokeut,uu%
  349. 3170 return
  350. 4000 rem move on board
  351. 4010 v1=fnpv(p1):forg1=1to10
  352. 4020 pokev1,81
  353. 4030 forg2=1to20:nextg2
  354. 4040 pokev1,87
  355. 4050 forg2=1to20:nextg2
  356. 4060 nextg1
  357. 4070 v2=fnpv(p2):forg1=1to10
  358. 4080 pokev2,87
  359. 4090 forg2=1to20:nextg2
  360. 4100 pokev2,81
  361. 4110 forg2=1to20:nextg2
  362. 4120 nextg1
  363. 4130 ifint(p1/10)<>int(p2/10)then4150
  364. 4140 rp=p1+sgn(p2-p1):goto4160
  365. 4150 rp=p1+10*sgn(p2-p1)
  366. 4160 v3=fnpv(rp):pokev3,87
  367. 4170 return
  368.